perm filename STACK.7[AID,LSP] blob sn#385662 filedate 1978-10-01 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	'(THIS IS THE LAP FOR (STACK IO DSK (AID RPG)))
C00006 ENDMK
CāŠ—;
'(THIS IS THE LAP FOR (STACK IO DSK (AID RPG)))
'(COMPILED BY LISP FAST-ARITHMETIC COMPILER /687)
;COMPILED ON DECEMBER 2, 1976, AT 7:52 PM
(DECLARE (FASLAPSETUP/| T))

; These routines cause do iopushes and iopops on the uread channel (3)
; Some hackery goes on to allow this to happen independently of the
; number of IO buffers.

(LAP INPUSH FSUBR) 
(DEFSYM GODM 475744555744)
(DEFSYM STP 777700000000)
(PUSH P A) 

(MOVEI C (- UTIB 2))	;This computes the number of valid buffers in
(MOVE D 0 C)		;the ring by going around and looking at the 400000,,0
(SETZ TT)		;bit. The number of valid buffers is the number ahead of
L1			;the one currently being emptied that the disk pointer
(TLNE D 400000)		;(useti pointer) is pointing to.
(AOJ TT)
(HRRZ C 0 C)
(MOVE D 0 C)
(CAME D (- UTIB 2))
(JRST 0 L1)

(CALLI 3 10)		;wait till IO finished
(IOPUSH C A)		;inpush 3,1
(JRST 0 ERR)
(MOVE B INSTACK)	;This routine keeps its own stack
(HRRZ T (UTIHED 1))	;Here the byte offset into the current buffer is computed
(SUB T UTIHED)		;Compute word offset
(HLL T (UTIHED 1))	;byte offset is the same
(PUSH B  T)		;and save it
(PUSH B  (UTIHED 2))	;byte count in that buffer saved
(PUSH B TT)		;useti offset saved
(MOVEM B INSTACK)	;stack pointer saved
(MOVE B 0 P) 
(MOVEI A 'EREAD) 	;read new file
(CALL 2 '*APPLY) 
(JRST 0 G0001)
ERR
(MOVEI B '|IO Stack Overflow|) 
(MOVEI A 'T) 
(CALL B '*BREAK) 
G0001 
(SUB P (% 0 0 1 1)) 
(POPJ P) 

(ENTRY INPOP SUBR)
(ARGS INPOP (NIL . 0))
(IOPOP 3 1)			;iopop
(JRST 0 ERR)
(MTAPE C POINT)			;Mtape to get current (popped) useti pointer
(MOVE B INSTACK)
(MOVE TT POINT)
(SUB TT 0 B)			;use offset computed earlier to move pointer back
(JUMPGE TT AHEAD)
(SETZ TT)
AHEAD
USET
(USETI 3 0 TT)			;useti 3,?
(MOVEI T (+ UTIHED 11))
(EXCH T 121)
(INBUF C 6)			;re-initialize buffer ring for safety
(EXCH T 121)
(IN 3 0)			;read in some data
(JRST 0 OK)
(JRST 0 ERR)
OK
(SUB B (% 0 0 1 1))
(POP B  (UTIHED 2))		;byte count restored
(HRRZ T UTIHED)			;fix up byte pointer
(ADD T 0 B)			;by adding saved byte offset
(MOVEM T (UTIHED 1))
(SUB B (% 0 0 1 1))
(MOVEM B INSTACK)
(MOVEI A 3)
(CALLI A 400011)		;Showit (display file in WHO line)
(MOVEI 1 'T)
(POPJ P)
ERR
(MOVEI 2 '|No Such Saved Channel|)
(MOVEI 1 'T)
(JCALL 2 '*BREAK)
VALID (0)
POINT (JFCL)
	(0)
STACK (BLOCK 71)
INSTACK (777707←22 0 STACK)

NIL